MacTech 1 to 12

home *** CD-ROM | disk | FTP | other *** search

/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.01 Jan 89 / forth stuff / Trap Compiler < prev

Wrap

Text File | 1988-11-11 | 18.0 KB | 656 lines | [TEXT/MACH]

\ Trap compiler. See the end of this file for examples and \ instructions. This utility allows you to define your own \ trap "glue." Thus as new system traps become available, you \ you will be able to define their high-level interface \ symbolically (without using assembly language). It will also \ allow you to define a substitute syntax to the CALL interface, \ in case you need to modify (fix?) one of the existing traps. \ Note that in the latter case, you do not actually change the \ existing CALL, you simply define a new syntax which can be used \ in place of the CALL sequence. This utility is perhaps a bit \ of "overkill," but it does illustrate rather complex parsing \ and the tools presented here could be used to extended the Mach \ compiler or assembler into new areas. Waymen @ PASC \ Copyright 1988 Palo Alto Shipping Company \ All Rights Reserved \ Source format tabs = 4. \ Compiles to about 2600 bytes of object code. \ One might wonder whether it makes good sense to include a \ 2K utility in an application when all you need is a few \ trap calls (but, see my comments below). However, for casual \ use you might consider putting this code in your workspace, \ along with your commonly used constants, mach words, and \ other compiler utilities (that way they will always be \ available during your "experimental" sessions). If you are \ working on a serious application, I would suggest the following \ approach. Place all variables, mach words, and compiler \ utilities (such as this trap compiler) in a separate segment \ and when you finish your application use ResEdit to remove \ that very same segment from your finished application. \ This will work because mach words, variables, and compiler \ utilities (such as this trap compiler) do NOT need to be in \ memory during the execution of the code which they produce. \ Generally speaking, any word which only produces in-line code, \ most immediate words, or any child word which does not \ reference its parent at run-time can safely be removed from \ a finished application. If you are really concerned about \ making the smallest possible applications, then this is a \ technique which you should always use (as a final step, when \ you are completely finished with your program). If it seems \ risky to remove a segment from a finished application, just \ remember that there is NO WAY you can run code in another \ segment if that segment has NO jump-table entries (i.e. if \ you can't get to the code, why include it in your application?) \ Mach words, variables, and (most) compiler words don't use or \ create jump-table entries. This same principle is why you \ never have to mark mach words or variables as GLOBAL (there \ is one exception, if you write a CODE word which explicitly \ states "JSR <mach word>" or "LEA <mach word>" then the \ defined instance of that <mach word> must be in memory at \ run-time. Thus if <mach word> exists in another segment, it \ will need to be marked GLOBAL (however, it's always ok to \ say LEA <variable> or MOVE.L <variable>, thus variables "never" \ need to be marked as GLOBAL). ONLY MAC ALSO ASSEMBLER ALSO FORTH DEFINITIONS DECIMAL 0 CONSTANT FALSE -1 CONSTANT TRUE 32 CONSTANT BL \ Effective address modes 1 CONSTANT An \ address register direct 0 CONSTANT Dn \ data register direct \ Bit masks for MOVE <Src>,<Dst> instruction %1111000000111111 CONSTANT DstMask %1111111111000000 CONSTANT SrcMask \ Utility to allow "fetching" of last compiled instruction. : AsmWord ( n -- ) \ Backup n bytes and get the 16-bit value compiled at that offset. \ Compile the value as a LITERAL. ALLOT HERE W@ [COMPILE] LITERAL ; : AsmWord2 ( -- ) -2 AsmWord ; : AsmWord4 ( -- ) -4 AsmWord ; \ The following words move data to and from the \ subroutine stack. Provides quick "storage." \ >SR and SR> must be balanced within a word. CODE >SR ( n -- ) \ Quick storage ("to-sr") MOVE.L (A6)+,-(A7) RTS END-CODE MACH CODE SR> ( -- n ) \ "from-sr" MOVE.L (A7)+,-(A6) RTS END-CODE MACH CODE SR@ ( -- n ) \ "sr-fetch" MOVE.L (A7),-(A6) RTS END-CODE MACH : #Error ( n -- ) \ Report error number and ABORT. BASE @ SWAP DECIMAL CR ." Trap compiler error #" <# # # # # #> TYPE BASE ! ABORT ; GLOBAL : (:TRAP) ( trapWord <name> -- ) \ Creates a trap instance and defines the run-time \ (with DOES>). Also does a little error checking. DEPTH IF $F000 AND $A000 = IF CREATE IMMEDIATE DOES> \ Must precede with TOOLBOX 0100 #Error THEN THEN \ Missing or incorrect trap word. 0010 #Error ; : UpCase ( char -- 'char ) >SR SR@ ( char) ASCII ` > SR@ ( char) ASCII { < AND ( -1 or 0 ) -32 AND SR> + ; CODE $Member ( char addr -- f ) \ Returns TRUE if char is a member of the counted \ string at addr, otherwise false. MOVEA.L (A6)+,A0 MOVE.L (A6)+,D0 MOVEQ.L #TRUE,D2 \ default result MOVEQ.L #0,D1 MOVE.B (A0)+,D1 \ character count SUBQ.B #1,D1 BMI.S @20 @10 CMP.B (A0)+,D0 DBEQ D1,@10 BEQ.S @30 @20 MOVEQ.L #FALSE,D2 @30 MOVE.L D2,-(A6) RTS END-CODE CODE SkipBL ( addr -- addr' ) \ Starting at addr, returns addr of \ first non-blank character (an ascii \ blank=#32). Note that addr \ should point to a character, NOT \ a string count. MOVEA.L (A6)+,A0 MOVEQ.L #BL,D0 @10 CMP.B (A0),D0 BNE.S @20 ADDQ.L #1,A0 BRA.S @10 @20 MOVE.L A0,-(A6) RTS END-CODE CODE CharScan ( addr c -- addr' ) \ Given the counted string at addr, \ return a pointer to the first occurrence \ of character c, or return NIL (zero) if \ character is not in string. MOVE.L (A6)+,D0 MOVEA.L (A6)+,A0 MOVEQ.L #0,D1 MOVE.B (A0)+,D1 \ count SUBQ.B #1,D1 BMI.S @20 @10 CMP.B (A0)+,D0 DBEQ D1,@10 BNE.S @20 SUBQ.L #1,A0 MOVE.L A0,-(A6) RTS @20 CLR.L -(A6) RTS END-CODE : SValid ( char -- f ) \ Returns true is char is an L, W or B. " LWBlwb" $Member ; : PValid ( char -- f ) \ Returns true if char is an L, W, B, D, or A. " LWBDAlwbda" $Member ; : NValid ( char -- f ) \ Returns true if char is 0..7 " 01234567" $Member ; : RValid ( addr -- f ) \ Check for valid "n.s" sequence where \ n is 0..7, and s is L, W, or B. >SR SR@ ( addr) C@ NValid ( flag) SR@ ( addr) 1+ C@ ASCII . = ( flag) AND SR> ( addr) 2+ C@ SValid ( flag) AND ; : VerifyOutput { addrLimit addrOut | char numOut -- numOut } \ Verifies and counts the number of outputs. 1 +> addrOut 0 -> numOut BEGIN addrOut SkipBL -> addrOut addrLimit addrOut > WHILE addrOut C@ -> char char PValid IF char " LWBlwb" $Member IF 1 +> addrOut 1 +> numOut ELSE \ must be D or A addrOut 1+ RValid IF 4 +> addrOut 1 +> numOut ELSE \ Input must be in form of "Dn.s" or "An.s" \ where n is 0..7 and s is L, W, or B. 0020 #Error THEN THEN ELSE \ Character stream must begin with L, W, B, D, or A. 0030 #Error THEN REPEAT numOut ; : VerifyInput { addrLimit addrIn | char numIn addrOut -- numIn addrOut } \ Verifies and counts the number of inputs. addrOut will be zero if \ there is no output, otherwise addrOut points to ending dash (-). 0 -> numIn 0 -> addrOut 1 +> addrIn BEGIN addrIn SkipBL -> addrIn addrLimit addrIn > WHILE addrIn C@ -> char char PValid IF char " LWBlwb" $Member IF 1 +> addrIn 1 +> numIn ELSE \ must be D or A addrIn 1+ RValid IF 4 +> addrIn 1 +> numIn ELSE \ Input must be in form of "Dn.s" or "An.s" \ where n is 0..7 and s is L, W, or B. 0040 #Error THEN THEN ELSE char ASCII - = IF BEGIN \ scan for more -'s addrIn 1+ C@ ASCII - = WHILE 1 +> addrIn REPEAT addrIn -> addrOut addrLimit -> addrIn \ force exit of WHILE loop ELSE \ Input must be L, W, B, D, A, or - 0050 #Error THEN THEN REPEAT numIn addrOut ; : VerifyParams { | addrIn addrOut addrLimit numIn numOut -- addrIn addrOut numIn numOut } \ Verifies and counts the number of inputs and outputs. 0 -> numOut 0 -> numIn 0 -> addrOut \ Parse to closing parenthesis. ASCII ) WORD -> addrIn addrIn C@ 1+ addrIn + -> addrLimit addrIn ASCII ( CharScan ?DUP IF \ skip to optional left parenthesis. -> addrIn THEN addrLimit addrIn VerifyInput -> addrOut -> numIn addrOut IF addrLimit addrOut VerifyOutput -> numOut THEN addrIn 1+ addrOut 1+ numIn numOut ; : RegInput { offset mode addrIn | dst reg size -- } \ Compiles an input, moving from stack into register. \ Mode contains either D or A. mode ASCII A = 1 AND -> mode addrIn C@ ASCII 0 - -> reg addrIn 2+ C@ -> size \ Create destination effective address (<ea>). mode 6 SHIFT reg 9 SHIFT OR -> dst offset 0= IF \ Although we compile a move into register D0 \ (a general case), we patch the instruction \ with a new destination so that we can move \ into any register (i.e. use the dst <ea>). [ MOVE.L (A6)+,D0 AsmWord2 ] DstMask AND dst OR ELSE size " WBwb" $Member IF 2 +> offset [ MOVE.W 0(A6),D0 AsmWord4 ] ELSE [ MOVE.L 0(A6),D0 AsmWord4 ] THEN DstMask AND dst OR W, offset THEN W, ; : RegOutput { addrOut mode | reg size -- } \ Compiles an output, moving from register to stack. \ Result is sign extended if necessary. \ Mode contains either D or A. mode ASCII A = 1 AND -> mode addrOut C@ ASCII 0 - -> reg addrOut 2+ C@ UpCase -> size size " WB" $Member mode 0= AND IF \ a data register containing a byte or word \ length result, sign extend the result. size ASCII B = IF [ EXT.W D0 AsmWord2 ] reg OR W, THEN [ EXT.L D0 AsmWord2 ] reg OR W, THEN [ MOVE.L D0,-(A6) AsmWord2 ] SrcMask AND reg mode 3 SHIFT OR OR W, ; : (Output) { addrOut numOut | size -- } \ Compiles both stack and register based outputs. numOut IF numOut 0 DO addrOut SkipBL -> addrOut addrOut C@ UpCase -> size size ASCII L = IF [ MOVE.L (A7)+,-(A6) AsmWord2 ] W, ELSE size " WB" $Member IF [ MOVEA.W (A7)+,A0 AsmWord2 ] W, [ MOVE.L A0,-(A6) AsmWord2 ] W, ELSE \ register based, thus "size" is a \ register type (A or D) addrOut 1+ size RegOutput 3 +> addrOut THEN THEN 1 +> addrOut LOOP THEN ; : (Input) { addrIn numIn | offset size -- } \ Compiles both stack and register based inputs. numIn IF numIn 0 DO numIn I - 1- 4* -> offset addrIn SkipBL -> addrIn addrIn C@ UpCase -> size size ASCII L = IF \ long-word parameter to stack offset 0= IF [ MOVE.L (A6)+,-(A7) AsmWord2 ] ELSE [ MOVE.L 0(A6),-(A7) AsmWord4 ] W, offset THEN W, ELSE size " WB" $Member IF \ word or byte parameter to stack [ MOVE.W 0(A6),-(A7) AsmWord4 ] W, 2 +> offset offset W, ELSE \ Register based, thus "size" is a \ register type (A or D) offset size addrIn 1+ RegInput 3 +> addrIn THEN THEN 1 +> addrIn LOOP \ If ending offset was zero, we popped the last parameter, \ thus decrease the numIn stack count by one. offset 0= IF -1 +> numIn THEN numIn IF \ Drop input parameters. numIn 4* DUP 8 > IF [ ADDA.W #0,A6 AsmWord4 ] W, ELSE %111 AND 9 SHIFT [ ADDQ.L #8,A6 AsmWord2 ] OR THEN W, THEN THEN ; : ?FuncClr ( addrOut -- ) \ Clears space on stack (if needed) for function result. SkipBL C@ UpCase ( size) DUP ASCII L = IF ( size) DROP [ CLR.L -(A7) AsmWord2 ] W, ELSE ( size) " WB" $Member IF [ CLR.W -(A7) AsmWord2 ] W, THEN THEN ; \ Note that :TRAP and :PACK defined words produce in-line \ code (similar to MACH words). When used with TOOLBOX, they \ also swap the system stacks (EXG D4,A7) just as a high-level \ CALL routine would. If you need the effect of a "(CALL)" \ routine, use (TOOLBOX) <trap name> : :TRAP { trapWord | addrIn addrOut numIn numOut trapBegin -- } \ Defines a Mac trap call. Parses parameters from the input \ character stream. trapWord (:TRAP) VerifyParams -> numOut -> numIn -> addrOut -> addrIn 2 ALLOT HERE -> trapBegin numOut IF addrOut ?FuncClr THEN addrIn numIn (Input) trapWord W, addrOut numOut (Output) [ RTS AsmWord2 ] W, HERE trapBegin - trapBegin 2- W! ; : :PACK { trapWord selector | numOut numIn addrOut addrIn packBegin -- } \ Defines a Mac "pack" trap call. A "pack" requires a word length \ selector which is subsequently pushed onto the system stack. \ Parses parameters from the input character stream. trapWord (:TRAP) VerifyParams -> numOut -> numIn -> addrOut -> addrIn 2 ALLOT HERE -> packBegin numOut IF addrOut ?FuncClr THEN addrIn numIn (Input) \ Compile pack selector value. [ MOVE.W #0,-(A7) AsmWord4 ] W, selector W, trapWord W, addrOut numOut (Output) [ RTS AsmWord2 ] W, HERE packBegin - packBegin 2- W! ; CODE SwapStack ( -- ) EXG D4,A7 RTS END-CODE MACH : CompileTrap ( addr len -- ) \ Given addr to instructions, compile \ len-2 bytes of object code (len-2 because \ it skips the ending RTS). OVER >SR + SR> 2+ DO I W@ W, 2 +LOOP ; : VerifyTrap ( -- addr len flag ) \ Verifies that ticked (') word is a :TRAP or \ :PACK word (gets len and verifies that \ an RTS ends the code. ' 4+ ( addr) DUP W@ ( addr len) 2DUP + DUP 1 AND 0= IF W@ [ RTS AsmWord2 ] = ELSE \ addr+len produced an odd address. DROP FALSE THEN ; : TOOLBOX ( -- ) \ For :TRAP and :PACK defined traps, use TOOLBOX <trap name> \ as a substitute for CALL. VerifyTrap IF ( addr len) STATE @ IF [ EXG D4,A7 AsmWord2 ] W, ( addr len) CompileTrap [ EXG D4,A7 AsmWord2 ] W, ELSE SwapStack ( addr len) DROP 2+ EXECUTE SwapStack THEN ELSE \ Tried to use TOOLBOX on a non-trap word. ( addr len) \ removed by ABORT 0200 #Error THEN ; IMMEDIATE : (TOOLBOX) ( -- ) \ For :TRAP and :PACK defined traps, use (TOOLBOX) <trap name> \ as a substitute for (CALL). VerifyTrap IF ( addr len) STATE @ IF ( addr len) CompileTrap ELSE ( addr len) DROP 2+ EXECUTE THEN ELSE \ Tried to use (TOOLBOX) on a non-trap word. ( addr len) \ removed by ABORT 0300 #Error THEN ; IMMEDIATE \ =============================================================== \ =========================== Examples ========================== \ Important note: GetHandleSize and sfGetFile \ are used ONLY as examples. These traps ARE \ compiled CORRECTLY by the current CALL sequence. \ The general syntax for the trap compiler is: \ \ <trap word> :TRAP <trap name--your choice> <parameter list> \ \ The parameter list has the following form: \ ( <inputs> -- <output> ) \ The right (closing) parenthesis IS required. The beginning \ "(" is optional, but should be used because... it looks better. \ The <input> -- <output> symbols define the parameter size \ needed for the trap call in question (get that information from \ Inside Mac). The trap compiler will then size each parameter, \ so all input/outputs will be converted automatically to long-words \ (i.e. you always pass long-words, and results are returned as \ sign-extended 32-bit values). \ Example of a register-based trap. Consult Inside Mac \ for the proper registers. \ $A025 :TRAP GetHandleSize ( A0.L -- D0.L ) \ The value $A025 is the trap word for GetHandleSize. \ Register-based trap symbols (input/output) are: \ "An.s" for address register "n", parameter size is "s". \ "Dn.s" for data register "n", parameter size is "s". \ Thus, A0.L means that a long (.L) value is taken \ from the parameter stack and placed into address register \ A-zero. Note that the period (.) between the register number \ and the parameter size IS required. \ Here is an example of a stack-based pack call. \ $A9EA 2 :PACK sfGetFile ( WWLLWLLL ) \ The value 2 is the pack selector for sfGetFile (see IM I-519). \ Stack-based trap symbols (input/output) are: \ "L" is a long-word (32-bits), "W" is a word (16-bits), \ "B" is a byte (value in low-order byte of a word, note that for \ stack-based parameters a "B" is moved as a word because you must \ keep stack word aligned.) Spaces are optional. If you don't \ include the dash (--), all characters are considered to be input. \ It's ok, however, to say ( WWLLWLLL -- ) or ( W W L L W L L L - ) \ =================== Bug fixes for v2.14 ====================== \ These substitute for mistakes in the v2.14 trap CALL compiler. \ Explicit CODE-word fixes for these traps are also available in \ the GEnie RT library file "V2.14 Trap Fixes" $A05D :TRAP SwapMMUMode ( D0.B -- D0.B ) \ register based $A054 :TRAP UprString ( A0.L D0.W -- A0.L ) \ " " $AA2B :TRAP GetNextDevice ( L -- L ) \ stack based $AA17 :TRAP GetCPixel ( W W L -- ) \ " " \ ==================== Important Note ==================== \ Using the new trap. Note that you do NOT precede \ the trap name with CALL. Traps defined with :TRAP and \ :PACK use the syntax: TOOLBOX <trap name> or \ (TOOLBOX) <trap name>. \ : To32Bit ( -- n ) 1 TOOLBOX SwapMMUMode ; \ or \ : UpCase ( addr -- addr ) COUNT TOOLBOX UprString ; \ ================ Parameter Size Notes ================= \ How do you determine if a parameter is an L, W, or B? \ Long-word parameters (L's): all VAR's, pointers (Ptr), Handles, \ records that are longer than 4 bytes, floating point values. \ \ Word parameters (W's): INTEGER, BOOLEAN, CHAR, Byte \ \ Byte parameters (B's): 8-bit data does exist, but if you need \ to pass a byte (by value) to the ROM, it's passed as a word \ with the value in the low-order byte. Note that for register \ based traps, I sign-extend the returned byte to a long-word. \ This may or may not be what you want, it's a rare situation \ anyway and would probably never affect your code. \ Read the "fine print" whenever you reference the trap calling \ sequence in Inside Mac. This trap compiler MUST use the \ conventions for assembly language "glue." Watch out for pack \ calls (they'll need a selector) and make certain that the \ Pascal interface doesn't use a different parameter set than \ does assembly language (this is a common problem in register \ based trap calls). Remember, both the standard Mach CALL \ glue and this trap compiler use assembly language conventions \ when making trap calls.